home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / LISTS2.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  148 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program Lists2;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for using a doubly linked list. }
  13.  
  14. uses Objects, Containr, ctLists,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = object (TDoubleNode)
  24.       FirstName,
  25.       LastName,
  26.       Phone,
  27.       Company : PString;
  28.     constructor Init(ALastName, AFirstName, APhone, ACompany : string);
  29.     destructor Done; virtual;
  30.   end; { TContact }
  31.  
  32. constructor TContact.Init(ALastName, AFirstName, APhone, ACompany : string);
  33. begin
  34.   TDoubleNode.Init;
  35.   FirstName := NewStr(AFirstName);
  36.   LastName := NewStr(ALastName);
  37.   Phone := NewStr(APhone);
  38.   Company := NewStr(ACompany);
  39. end;
  40.  
  41. destructor TContact.Done;
  42. begin
  43.   DisposeStr(FirstName);
  44.   DisposeStr(LastName);
  45.   DisposeStr(Phone);
  46.   DisposeStr(Company);
  47.   TDoubleNode.Done;
  48. end;
  49.  
  50. procedure DisplayContacts(ContactList : PSequence);
  51.  
  52.   procedure PrintInfo (Item : Pointer); far;
  53.   begin
  54.     with PContact(Item)^ do
  55.       writeln(LastName^, '':15 - Length(LastName^),
  56.         FirstName^, '':15 - Length(FirstName^),
  57.         Phone^, '':20 - Length(Phone^),
  58.         Company^, '':20 - Length(Company^));
  59.   end;
  60.  
  61. begin
  62.   ContactList^.ForEach(@PrintInfo);
  63. end;
  64.  
  65. procedure DisplayFirst(ContactList : PSequence);
  66. var
  67.   Item : Pointer;
  68.   Index : LongInt;
  69. begin
  70.   Item := ContactList^.First(Index);
  71.   Writeln('First item:');
  72.   with PContact(Item)^ do
  73.     writeln(LastName^, '':15 - Length(LastName^),
  74.       FirstName^, '':15 - Length(FirstName^),
  75.       Phone^, '':20 - Length(Phone^),
  76.       Company^, '':20 - Length(Company^));
  77.   ContactList^.DoneItem(Item); { not required }
  78. end;
  79.  
  80. procedure DisplayLast(ContactList : PSequence);
  81. var
  82.   Item : Pointer;
  83.   Index : LongInt;
  84. begin
  85.   Item := ContactList^.Last(Index);
  86.   Writeln('Last item:');
  87.   with PContact(Item)^ do
  88.     writeln(LastName^, '':15 - Length(LastName^),
  89.       FirstName^, '':15 - Length(FirstName^),
  90.       Phone^, '':20 - Length(Phone^),
  91.       Company^, '':20 - Length(Company^));
  92.   ContactList^.DoneItem(Item); { not required }
  93. end;
  94.  
  95. procedure FindLastName(ContactList : PSequence; LastName : string);
  96. var
  97.   Item : Pointer;
  98.   Index : LongInt;
  99.  
  100.   function MatchLastName (Item : Pointer): boolean; far;
  101.   begin
  102.     MatchLastName := (LastName = PContact(Item)^.LastName^);
  103.   end;
  104.  
  105. begin
  106.   Item := ContactList^.FirstThat(@MatchLastName, Index);
  107.   Writeln('Item found with last name ''', LastName, ''':');
  108.   with PContact(Item)^ do
  109.     writeln(LastName^, '':15 - Length(LastName^),
  110.       FirstName^, '':15 - Length(FirstName^),
  111.       Phone^, '':20 - Length(Phone^),
  112.       Company^, '':20 - Length(Company^));
  113.   ContactList^.DoneItem(Item); { not required }
  114. end;
  115.  
  116. var
  117.   ContactInfo : PDoubleList;
  118.  
  119. begin
  120.   ClrScr;
  121.  
  122.   { Create the list }
  123.   ContactInfo := New(PDoubleList, Init);
  124.  
  125.   { Insert items into the list }
  126.   with ContactInfo^ do
  127.   begin
  128.     Insert(New(PContact, Init('Lewis', 'Carl', '(506) 83-780',
  129.       'Running, Corp.')));
  130.     Insert(New(PContact, Init('Benton', 'Michael', '(403) 33-973',
  131.       'ER, Inc.')));
  132.     Insert(New(PContact, Init('Wagner', 'Robert', '(906) 11-230',
  133.       'Symphony, Ltd.')));
  134.     Insert(New(PContact, Init('Smith', 'John', '(656) 75-843',
  135.       'InterComm, Corp.')));
  136.   end; { with }
  137.  
  138.   DisplayContacts(ContactInfo);
  139.   Writeln;
  140.   DisplayFirst(ContactInfo);
  141.   Writeln;
  142.   DisplayLast(ContactInfo);
  143.   Writeln;
  144.   FindLastName(ContactInfo, 'Wagner');
  145.  
  146.   { Dispose of the list and all the objects in it }
  147.   Dispose(ContactInfo, Done);
  148. end.